home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / pbc_bas.exe / BOXMENU1.BAS < prev    next >
BASIC Source File  |  1993-01-11  |  12KB  |  319 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE SUB BIOSInkey (AscCode%, ScanCode%)
  8.    DECLARE SUB CalcSize (BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, Elements%)
  9.    DECLARE SUB CursorInfo (Visible%, StartLine%, EndLine%, MaxLine%)
  10.    DECLARE SUB Delay18th (BYVAL WaitTime%)
  11.    DECLARE SUB DGetScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
  12.    DECLARE SUB DPutScreen (BYVAL DSeg%, BYVAL DOfs%, BYVAL TopRow%, BYVAL LeftCol%, BYVAL BottomRow%, BYVAL RightCol%, BYVAL Page%, BYVAL Fast%)
  13.    DECLARE FUNCTION GetCRT2% ()
  14.    DECLARE FUNCTION GetEGA2% ()
  15.    DECLARE SUB GetKey (Mouse%, ASCIICode%, ScanCode%, LeftButton%, RightButton%)
  16.    DECLARE SUB GetMouseLoc (Row%, Column%)
  17.    DECLARE FUNCTION GetVGA2% ()
  18.    DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
  19.    DECLARE SUB MMButton3 (LeftB%, MidB%, RightB%)
  20.    DECLARE SUB MMCursorOff ()
  21.    DECLARE SUB MMCursorOn ()
  22.    DECLARE SUB UnCalcAttr (Foreground%, Background%, BYVAL VAttr%)
  23.    DECLARE SUB WindowManager (TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, Fore%, Back%, Grow%, Shade%, TFore%, Title$, Page%, Fast%)
  24.    DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL VAttr%, BYVAL Page%, BYVAL Fast%)
  25.  
  26. SUB BoxMenu1 (Mouse%, PickList$(), Picked%(), Marker$, TopRow%, LeftCol%, BottomRow%, Frame%, FrameAttr%, ItemListAttr%, HiliteAttr%, TitleFore%, Title$, Grow%, Shade%, Picks%)
  27.  
  28.    CursorInfo Visible%, StartLine%, EndLine%, MaxLine%
  29.    IF Visible% THEN LOCATE , , 0
  30.  
  31.    IF LEN(Marker$) > 1 THEN
  32.       LMarker$ = LEFT$(Marker$, 1)
  33.       RMarker$ = MID$(Marker$, 2, 1)
  34.    ELSE
  35.       LMarker$ = "<"
  36.       RMarker$ = ">"
  37.    END IF
  38.  
  39.    LastItem% = 0
  40.    Columns% = 0
  41.    Picks% = 0
  42.    t1% = UBOUND(PickList$, 1)
  43.    FOR tmp% = t1% TO 1 STEP -1
  44.       t2% = LEN(PickList$(tmp%))
  45.       IF t2% THEN
  46.          IF LastItem% = 0 THEN LastItem% = tmp%
  47.          IF Columns% < t2% THEN Columns% = t2%
  48.          IF Picked%(tmp%) THEN Picks% = Picks% + 1
  49.       END IF
  50.    NEXT
  51.    IF LastItem% THEN
  52.       Columns% = Columns% + 2
  53.       IF Columns% > 75 THEN Columns% = 75
  54.       FOR tmp% = 1 TO LastItem%
  55.          IF LEN(PickList$(tmp%)) = 0 THEN Picked%(tmp%) = 0
  56.       NEXT
  57.    ELSE
  58.       Columns% = 14
  59.    END IF
  60.  
  61.    GetVidMode VMode%, Cols%, Page%          ' use active display page
  62.  
  63.    IF GetCRT2% THEN                         ' use fast display unless CGA
  64.       IF GetEGA2% OR GetVGA2% THEN
  65.          Fast% = -1
  66.       ELSE
  67.          Fast% = 0
  68.       END IF
  69.    ELSE
  70.       Fast% = -1
  71.    END IF
  72.  
  73.    RightCol% = LeftCol% + Columns% - 1      ' set right column
  74.    Rows% = BottomRow% - TopRow% + 1         ' and number of rows
  75.  
  76.    IF Shade% THEN
  77.       CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Words%
  78.    ELSE
  79.       CalcSize TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Words%
  80.    END IF
  81.    DIM SavedScreen%(Words%)
  82.  
  83.    TopRec% = 1
  84.    HiliteRow% = 1
  85.  
  86.    '--- save the screen
  87.    IF Mouse% THEN MMCursorOff
  88.    DSeg% = VARSEG(SavedScreen%(1))
  89.    DOfs% = VARPTR(SavedScreen%(1))
  90.    IF Shade% THEN
  91.       DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 2, RightCol% + 3, Page%, Fast%
  92.    ELSE
  93.       DGetScreen DSeg%, DOfs%, TopRow% - 1, LeftCol% - 1, BottomRow% + 1, RightCol% + 1, Page%, Fast%
  94.    END IF
  95.  
  96.    UnCalcAttr FrameFore%, FrameBack%, FrameAttr%
  97.    WindowManager TopRow%, LeftCol%, BottomRow%, RightCol%, Frame%, FrameFore%, FrameBack%, Grow%, Shade%, TitleFore%, Title$, Page%, Fast%
  98.    IF Mouse% THEN MMCursorOn
  99.    GOSUB DisplayItems
  100.  
  101.    DO
  102.       '--- get input from appropriate device(s)
  103.       IF LeftButton% THEN Delay18th 2
  104.       DO
  105.          IF Mouse% THEN MMButton3 LeftButton%, MidButton%, RightButton%
  106.          IF LeftButton% = 0 AND MidButton% = 0 AND RightButton% = 0 THEN
  107.             BIOSInkey AsciiCode%, ScanCode%
  108.          END IF
  109.       LOOP UNTIL LeftButton% OR MidButton% OR RightButton% OR AsciiCode% OR ScanCode%
  110.       '--- handle mouse input, if any
  111.       IF Mouse% THEN
  112.          IF RightButton% THEN
  113.             AsciiCode% = 27
  114.          ELSEIF (LastItem% < 1) AND (LeftButton% OR MidButton%) THEN
  115.             AsciiCode% = 27
  116.          ELSEIF MidButton% THEN
  117.             AsciiCode% = 13
  118.          ELSEIF LeftButton% THEN
  119.             GetMouseLoc MouseRow%, MouseCol%
  120.             IF MouseRow% >= TopRow% AND MouseRow% <= BottomRow% THEN
  121.                IF MouseCol% = RightCol% + 1 THEN
  122.                   tmp% = SCREEN(MouseRow%, MouseCol%)
  123.                   IF tmp% = 24 THEN
  124.                      ' convert to ^E (same as up arrow)
  125.                      AsciiCode% = 5
  126.                   ELSEIF tmp% = 25 THEN
  127.                      ' convert to ^X (same as down arrow)
  128.                      AsciiCode% = 24
  129.                   END IF
  130.                ELSEIF MouseCol% >= LeftCol% AND MouseCol% <= RightCol% THEN
  131.                   IF MouseRow% - TopRow% + TopRec% <= LastItem% THEN
  132.                      HiLiteRow% = MouseRow% - TopRow% + 1
  133.                      AsciiCode% = 32
  134.                   END IF
  135.                END IF
  136.             END IF
  137.          END IF
  138.       END IF
  139.       '--- handle keyboard input, if any
  140.       IF AsciiCode% <> 0 OR ScanCode% <> 0 THEN
  141.          IF AsciiCode% = 17 THEN          ' ^Q WordStar key combo processing
  142.             GetKey Mouse%, AsciiCode%, ScanCode%, LeftButton%, RightButton%
  143.             SELECT CASE AsciiCode%
  144.                CASE 3                     ' ^QC converts to ^<PgDn>
  145.                   AsciiCode% = 0
  146.                   ScanCode% = 118
  147.                CASE 18                    ' ^QR converts to ^<PgUp>
  148.                   AsciiCode% = 0
  149.                   ScanCode% = 132
  150.                CASE ELSE
  151.                   AsciiCode% = 0
  152.                   ScanCode% = 0
  153.             END SELECT
  154.          END IF
  155.          IF AsciiCode% = 0 AND ScanCode% = 71 THEN
  156.             ' <HOME>
  157.             IF HiliteRow% > 1 THEN
  158.                HiliteRow% = 1
  159.                GOSUB DisplayItems
  160.             END IF
  161.          ELSEIF AsciiCode% = 0 AND ScanCode% = 79 THEN
  162.             ' <END>
  163.             IF TopRec% + Rows% > LastItem% THEN
  164.                HiliteRow% = LastItem% - TopRec% + 1
  165.             ELSE
  166.                HiliteRow% = Rows%
  167.             END IF
  168.             GOSUB DisplayItems
  169.          ELSEIF AsciiCode% = 0 AND ScanCode% = 118 THEN
  170.             ' <CTRL><PGDN>
  171.             TopRec% = LastItem% - Rows% + 1
  172.             IF TopRec% < 1 THEN TopRec% = 1
  173.             IF TopRec% + Rows% > LastItem% THEN
  174.                HiliteRow% = LastItem% - TopRec% + 1
  175.             ELSE
  176.                HiliteRow% = Rows%
  177.             END IF
  178.             GOSUB DisplayItems
  179.          ELSEIF AsciiCode% = 0 AND ScanCode% = 132 THEN
  180.             ' <CTRL><PGUP>
  181.             IF TopRec% > 1 OR HiliteRow% > 1 THEN
  182.                TopRec% = 1
  183.                HiliteRow% = 1
  184.                GOSUB DisplayItems
  185.             END IF
  186.          ELSEIF AsciiCode% = 3 OR AsciiCode% = 0 AND ScanCode% = 81 THEN
  187.             ' ^C or PgDn
  188.             IF TopRec% + 2 * Rows% - 1 < LastItem% THEN
  189.                TopRec% = TopRec% + Rows%
  190.             ELSE
  191.                TopRec% = LastItem% - Rows% + 1
  192.                IF TopRec% < 1 THEN TopRec% = 1
  193.             END IF
  194.             IF TopRec% > LastItem% THEN TopRec% = LastItem%
  195.             IF TopRec% + HiliteRow% - 1 >= LastItem% THEN
  196.                HiliteRow% = LastItem% - TopRec% + 1
  197.             END IF
  198.             GOSUB DisplayItems
  199.          ELSEIF AsciiCode% = 5 OR AsciiCode% = 0 AND ScanCode% = 72 THEN
  200.             ' ^E or up arrow
  201.             IF HiliteRow% > 1 OR TopRec% > 1 THEN
  202.                IF HiliteRow% > 1 THEN
  203.                   HiliteRow% = HiliteRow% - 1
  204.                EL